home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE09 / CODERS / METHDFRM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-20  |  3KB  |  144 lines
  1. unit Methdfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils,
  7.   WinTypes,
  8.   WinProcs,
  9.   Messages,
  10.   Classes,
  11.   Graphics,
  12.   Controls,
  13.   Forms,
  14.   Dialogs,
  15.   ClipBrd,
  16.   StdCtrls,
  17.   ExtCtrls,
  18.   StrFunc,
  19.   ExptTool ;
  20.  
  21. type
  22.   TMethGenFrm = class(TForm)
  23.     ClassNameAcquireBtn: TButton;
  24.     MethodsAquireBtn: TButton;
  25.     MethodsGenBtn: TButton;
  26.     PasteBtn: TButton;
  27.     OnTopBtn: TButton;
  28.     ExitBtn: TButton;
  29.     ClassNameEdit: TEdit;
  30.     MethodsMemo: TMemo;
  31.     SkeletonsMemo: TMemo;
  32.     TopBevel: TBevel;
  33.     CenterBevel: TBevel;
  34.     BottomPanel: TPanel;
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure ClassNameAcquireBtnClick(Sender: TObject);
  37.     procedure MethodsAquireBtnClick(Sender: TObject);
  38.     procedure MethodsGenBtnClick(Sender: TObject);
  39.     procedure PasteBtnClick(Sender: TObject);
  40.     procedure OnTopBtnClick(Sender: TObject);
  41.     procedure ExitBtnClick(Sender: TObject);
  42.   private
  43.     { Private declarations }
  44.   public
  45.     OnTop : boolean ;
  46.     { Public declarations }
  47.   end;
  48.  
  49. var
  50.   MethGenFrm: TMethGenFrm;
  51.  
  52. implementation
  53.  
  54. {$R *.DFM}
  55. procedure TMethGenFrm.FormCreate(Sender: TObject);
  56. begin
  57.   OnTop := FALSE ;
  58.   OnTopBtn.Caption := '&On Top' ;
  59. end;
  60.  
  61. procedure TMethGenFrm.ClassNameAcquireBtnClick(Sender: TObject);
  62. begin
  63.   SendMessage( FindChild( 'TEditWindow', 'TEditControl' ), WM_COPY, 0, 0 ) ;
  64.   ClassNameEdit.Text := Clipboard.AsText ;
  65. end;
  66.  
  67. procedure TMethGenFrm.MethodsAquireBtnClick(Sender: TObject);
  68. const
  69.   BufSize = 2048 ;
  70. var
  71.   TheBuf : PChar ;
  72.   TheLen : word ;
  73. begin
  74.   SendMessage( FindChild( 'TEditWindow', 'TEditControl' ), WM_COPY, 0, 0 ) ;
  75.   GetMem( TheBuf, BufSize ) ;
  76.   Clipboard.GetTextBuf( TheBuf, BufSize ) ;
  77.   MethodsMemo.SetTextBuf( TheBuf ) ;
  78.   FreeMem( TheBuf, BufSize ) ;
  79. end;
  80.  
  81. procedure TMethGenFrm.MethodsGenBtnClick(Sender: TObject);
  82. var
  83.   i, index : integer ;
  84.   WorkStr : string ;
  85. begin
  86.   for i := 0 to MethodsMemo.Lines.Count do
  87.   begin
  88.     WorkStr := MethodsMemo.Lines[i] ;
  89.     if WorkStr <> '' then
  90.     begin
  91.       WorkStr := LTrim( WorkStr, ' ' ) ;
  92.       index := Pos( ' ', WorkStr ) ;
  93.       while WorkStr[index] = ' ' do
  94.         Inc( index ) ;
  95.       Insert( ClassNameEdit.Text + '.', WorkStr, index ) ;
  96.       SkeletonsMemo.Lines.Add( WorkStr ) ;
  97.       SkeletonsMemo.Lines.Add( 'begin' ) ;
  98.       SkeletonsMemo.Lines.Add( '' ) ;
  99.       SkeletonsMemo.Lines.Add( 'end ;' ) ;
  100.       SkeletonsMemo.Lines.Add( '' ) ;
  101.     end ;
  102.   end ;
  103. end;
  104.  
  105. procedure TMethGenFrm.PasteBtnClick(Sender: TObject);
  106. var
  107.   TheBuf : PChar ;
  108.   TheLen : word ;
  109. begin
  110.   TheLen := SkeletonsMemo.GetTextLen ;
  111.   GetMem( TheBuf, TheLen ) ;
  112.   SkeletonsMemo.GetTextBuf( TheBuf, TheLen ) ;
  113.   Clipboard.SetTextBuf( TheBuf ) ;
  114.   FreeMem( TheBuf, TheLen ) ;
  115.   SendMessage( FindChild( 'TEditWindow', 'TEditControl' ), WM_PASTE, 0, 0 ) ;
  116. end;
  117.  
  118. procedure TMethGenFrm.OnTopBtnClick(Sender: TObject);
  119. begin
  120.   OnTop := not OnTop ;
  121.  
  122.   case OnTop of
  123.     TRUE :
  124.     begin
  125.       NoStayOnTop( Handle ) ;
  126.       OnTopBtn.Caption := '&On Top' ;
  127.     end ;
  128.  
  129.     FALSE :
  130.     begin
  131.       StayOnTop( Handle ) ;
  132.       OnTopBtn.Caption := '&Off Top' ;
  133.     end ;
  134.  
  135.   end ;
  136. end;
  137.  
  138. procedure TMethGenFrm.ExitBtnClick(Sender: TObject);
  139. begin
  140.   Close ;
  141. end;
  142.  
  143. end.
  144.